home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / dll_gen / drvtype / drvtype.bas next >
Encoding:
BASIC Source File  |  1995-12-29  |  3.8 KB  |  92 lines
  1. '┌─────────────────────────────────────────────────────────────────────────────┐
  2. '│                                                                             │
  3. '│  GetDriveType for PB/DLL                                                    │
  4. '│  Copyright (c) 1995 by PowerBASIC, Inc.                                     │
  5. '│                                                                             │
  6. '│  In Visual Basic:                                                           │
  7. '│    Declare Function pbGetDriveType% Lib "DRVTYPE.DLL" (ByVal Drive%)        │
  8. '│                                                                             │
  9. '│  Returns:                                                                   │
  10. '│    DRIVE_UNKNOWN   = 0                                                      │
  11. '│    DRIVE_NOROOT    = 1                                                      │
  12. '│    DRIVE_REMOVABLE = 2                                                      │
  13. '│    DRIVE_FIXED     = 3                                                      │
  14. '│    DRIVE_REMOTE    = 4                                                      │
  15. '│    DRIVE_CDROM     = 5       ' Windows 95/NT only                           │
  16. '│    DRIVE_RAMDISK   = 6       ' Windows 95/NT only                           │
  17. '│                                                                             │
  18. '└─────────────────────────────────────────────────────────────────────────────┘
  19.  
  20. $COMPILE DLL "DRVTYPE.EXE"
  21. $INCLUDE "WINAPI.INC"
  22.  
  23. DIM lpGetDriveTypeA     AS SHARED DWORD ' address of GetDriveTypeA
  24. DIM lpCallProc32W       AS SHARED DWORD ' address of CallProc32W
  25. DIM lpFreeLibrary32W    AS SHARED DWORD ' address of FreeLibrary32W 3
  26. DIM lpLoadLibraryEx32W  AS SHARED DWORD ' address of LoadLibraryEx32W
  27. DIM lpGetProcAddress32W AS SHARED DWORD ' address of GetProcAddress32W
  28.  
  29. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  30.  
  31. FUNCTION LibMain ( BYVAL hModule     AS INTEGER, _
  32.                    BYVAL wDataSeg    AS WORD, _
  33.                    BYVAL cbHeapSize  AS WORD, _
  34.                    lpszCmdLine AS ASCIIZ ) EXPORT AS INTEGER
  35.  
  36.   DIM hInstKernel       AS WORD
  37.   DIM hInstKernel32     AS DWORD
  38.   DIM Text              AS ASCIIZ * 255
  39.  
  40.   hInstKernel = LoadLibrary("KERNEL")
  41.  
  42.   lpLoadLibraryEx32W =  GetProcAddress(hinstKernel, "LOADLIBRARYEX32W")
  43.   lpGetProcAddress32W = GetProcAddress(hinstKernel, "GETPROCADDRESS32W")
  44.   lpCallProc32W = GetProcAddress(hinstKernel, "CALLPROC32W")
  45.   lpFreeLibrary32W = GetProcAddress(hinstKernel, "FREELIBRARY32W")
  46.  
  47.   IF ISFALSE(lpLoadLibraryEx32W) THEN   ' is WOW thunking layer present?
  48.     EXIT FUNCTION                       ' no, exit
  49.   END IF
  50.  
  51.   FreeLibrary hinstKernel
  52.  
  53.   '** load KERNEL32 into memory and put 32-bit handle in hInstKernel32
  54.   CALL DWORD lpLoadLibraryEx32W BDECL ("KERNEL32", BYVAL 0???, BYVAL 0???)
  55.   ! mov hInstKernel32[0], AX
  56.   ! mov hInstKernel32[2], DX
  57.  
  58.   '** Get address of "GetDriveTypeA" and place into lpGetDriveTypeA
  59.   CALL DWORD lpGetProcAddress32W BDECL (BYVAL hInstKernel32, "GetDriveTypeA")
  60.   ! mov lpGetDriveTypeA[0], AX
  61.   ! mov lpGetDriveTypeA[2], DX
  62.  
  63.   CALL DWORD lpFreeLibrary32W BDECL (BYVAL hInstKernel32)
  64.  
  65. END FUNCTION
  66.  
  67.  
  68. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  69.  
  70. FUNCTION pbGetDriveType(BYVAL Drive AS INTEGER) EXPORT AS INTEGER
  71.  
  72.   DIM DriveText AS ASCIIZ * 10
  73.   DIM DrivePtr  AS DWORD
  74.  
  75.   IF lpCallProc32W > 0 THEN            ' 32-bit call
  76.  
  77.     IF Drive > 0 THEN
  78.       DriveText = CHR$(64+Drive) + ":\"
  79.       DrivePtr = VARPTR(DriveText)
  80.     END IF
  81.     CALL DWORD lpCallProc32W BDECL (BYVAL DrivePtr, BYVAL lpGetDriveTypeA, _
  82.                                     BYVAL 1???, BYVAL 1???)
  83.     ! mov FUNCTION, AX
  84.  
  85.   ELSE                                 ' 16-bit call
  86.  
  87.     FUNCTION = GetDriveType( Drive )
  88.  
  89.   END IF
  90.  
  91. END FUNCTION
  92.